home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Software Vault: The Gold Collection
/
Software Vault - The Gold Collection (American Databankers) (1993).ISO
/
cdr36
/
lod370e.zip
/
PROGRAMR.ZIP
/
MESSGIO.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1992-12-01
|
4KB
|
181 lines
unit messgio;
interface
const
max_msg_lines=100;
msys_open: boolean =false;
type
message_rec=record
From: string[35];
m_to: string[35];
subject: string[72];
datetime: string[19];
timesread: word;
replyto: word;
attribute: word;
nextreply: word;
lines: integer;
text: array[1..max_msg_lines] of string[78];
end;
message_ptr = ^message_rec;
index_rec=record
From: string[35];
m_to: string[35];
subject: string[72];
datetime: string[19];
timesread: word;
replyto: word;
attribute: word;
nextreply: word;
lines: integer;
addr: longint;
len: word;
end;
procedure open_msys;
procedure close_msys;
procedure Get_Message(msgnum: word; var mr: message_rec);
procedure Add_Message(var msgnum: word; var mr: message_rec);
procedure Get_Message_Header(msgnum: word; var mr: message_rec);
function find_highest_message: word;
procedure killmessage(mnum: word);
implementation
type
mbuff=array[1..8192] of char;
mbuffptr=^mbuff;
var
idxfile: file of index_Rec;
bdyfile: file;
procedure open_msys;
var
tidx: index_rec;
begin;
assign(idxfile,'MSGIDX.DAT');
{$I-}
reset(idxfile);
{$I+}
if ioresult<>0 then begin;
rewrite(idxfile);
reset(idxfile);
end;
assign(bdyfile,'MSGBDY.DAT');
{$i-}
reset(bdyfile,1);
{$I+}
if ioresult<>0 then begin;
rewrite(bdyfile);
reset(bdyfile,1);
end;
msys_open:=true;
end;
procedure close_msys;
begin;
if msys_open<>true then exit;
msys_open:=false;
close(idxfile);
close(bdyfile);
end;
procedure Get_Message(msgnum: word; var mr: message_rec);
var
idx: index_rec absolute mr;
tbuff: mbuffptr;
idxlen: word;
a: word;
begin;
seek(idxfile,msgnum-1);
read(idxfile,idx);
idxlen:=idx.len;
mr.lines:=0;
if idxlen>0 then begin;
getmem(tbuff,idxlen);
{$I-}
seek(bdyfile,idx.addr);
{$I+}
if ioresult=0 then begin;
{$i-}
blockread(bdyfile,tbuff^,idxlen);
{$i+}
if ioresult=0 then begin;
a:=1;
mr.lines:=1;
mr.text[1]:='';
while (a<=idxlen) and (mr.lines<max_msg_lines) do begin;
if tbuff^[a]=#13 then begin;
inc(mr.lines);
mr.text[mr.lines]:='';
end else mr.text[mr.lines]:=mr.text[mr.lines]+tbuff^[a];
inc(a);
end;
end;
end;
freemem(tbuff,idxlen);
end;
end;
procedure Add_Message(var msgnum: word; var mr: message_rec);
var
idx: index_rec absolute mr;
idxlen,idxaddr: longint;
tbuff: mbuffptr;
a,b: word;
begin;
msgnum:=filesize(idxfile);
idxaddr:=filesize(bdyfile);
idxlen:=0;
getmem(tbuff,8192);
for a:=1 to mr.lines do begin;
for b:=1 to length(mr.text[a]) do begin;
inc(idxlen);
tbuff^[idxlen]:=mr.text[a][b];
end;
inc(idxlen);
tbuff^[idxlen]:=#13;
end;
seek(bdyfile,idxaddr);
blockwrite(bdyfile,tbuff^,idxlen);
freemem(tbuff,8192);
idx.addr:=idxaddr;
idx.len:=idxlen;
seek(idxfile,msgnum);
write(idxfile,idx);
inc(msgnum);
end;
procedure Get_Message_Header(msgnum: word; var mr: message_rec);
var
idx: index_rec absolute mr;
begin;
seek(idxfile,msgnum-1);
read(idxfile,idx);
end;
function find_highest_message: word;
begin;
find_highest_message:=filesize(idxfile);
end;
procedure killmessage(mnum: word);
var
idx: index_rec;
begin;
seek(idxfile,mnum-1);
read(idxfile,idx);
idx.m_to:='DELETED';
idx.from:='DELETED';
idx.addr:=0;
idx.len:=0;
seek(idxfile,mnum-1);
write(idxfile,idx);
end;
end.